\ fsfdf 00.7.19 JCF
\ Included by NewFloatMgr.
\ Assumes 16 bit words, 2's compl.
\ (68328-palmos-q4th architecture)
\ SF>F will THROW for any IEEE value
\ that has no FFP representation
\ (exp out of range, infinities, NaNs,
\ denormals [they're out of range
\ anyway], and -0).

needs core-ext
needs sfdf

: F>SF 
[ FALIGN HERE LITERAL
1 FLOATS ALLOT ] DUP F! 2@
2DUP D+ 2DUP D0= 0= IF
SWAP ( mh mlse )
DUP 255 AND ( ... e )
128 - 2/ 130 - 255 AND
OVER 256 AND ( s ) OR ( se )
7 LSHIFT >R ( mh mlse )
9 RSHIFT OVER 7 LSHIFT OR
SWAP ( ml mh )
9 RSHIFT R> OR ( ml semh )
THEN ;

: SF>F 
[ FALIGN HERE LITERAL
1 FLOATS ALLOT ] DUP 2SWAP
2DUP D0= 0= IF
DUP ( ml semh semh )
7 RSHIFT 255 AND 126 - ( ml semh e )
OVER
0< IF DUP -64 ELSE DUP -63 THEN
64 WITHIN IF
64 + OVER 0< IF 128 OR THEN ( se )
>R ( ml semh ) 8 LSHIFT
OVER 8 RSHIFT OR SWAP ( mh ml )
8 LSHIFT R> OR ( mh mlse )
SWAP (hex) 8000 OR
ELSE ( ml semh e )
SWAP 127 AND ROT OR SWAP ( m? e )
DUP 129 = IF DROP IF
-46 THROW THEN \ NaN
-43 THROW THEN \ infinity
DUP -126 = IF DROP IF
-54 THROW THEN \ den => underflow
-46 THROW THEN \ can't cvrt -0
0< IF -54 THROW THEN \ underflow
-43 THROW
THEN THEN
ROT 2! F@ ;

: SF!  >R F>SF R> SF!SF ;

: SF@  SF@SF SF>F ;
